perm filename CPYIT.FAI[XX,LCS] blob
sn#206580 filedate 1976-03-15 generic text, type T, neo UTF8
00100 ;***** COPYIT
00200 TITLE COPYIT
00300 INTERNAL COPYIT,UPDN,STFCH,NOIR,SLEND,POSIT
00400 EXTERNAL .COMM.,POSI,XRN,PTR,SCM,AMOD
00500 EXTERNAL OUTLIM,RTLINE,LOOP
00600 ;; DEFINE FLOAT(N)
00700 ;; < TLC N,232000
00800 ;; FADR N,N >
00900 DEFINE FIXX(N)
01000 < JUMPGE N,.+5
01100 MOVNS N
01200 FIX N,233000
01300 MOVNS N
01400 CAIA
01500 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
01600
01700 ; SUBROUTINE COPYIT
01800 ; COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
01900 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
02000 ; 1/PTR/PWDS(250),ITEM,LL,I,IX
02100 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
02200 ; 1,(R6,RJQ(4)),(N,RN(2500))
02300 STFCH: 0
02400 SETO 13, ;FLAG FOR STFCH ROUTINE
02500 JRST .+3
02600
02700 COPYIT: 0
02800 SETZ 13, ;MAKE SURE IT'S 0
02900 SETZ 7, ;IM=ITEM
03000 MOVE 15,PTR+=250 ; AC7 IS K-1
03100 SOJ 15, ;(ITEM-1)
03200 CP1: JSA 16,RTLINE ;DO 1 K=1,IM
03300 JUMP PTR(7) ;L=PWDS(K)
03400 JUMPL CPY ; IF(RTLINE(L))GO TO 1
03500 JSA 16,OUTLIM ;IF(OUTLIM(L,3))GO TO 1
03600 JUMP PTR(7)
03700 JUMP [3]
03800 JUMPL CPY
03900 MOVE 11,PTR(7) ; NOW L IS AC11
04000 MOVE 10,.COMM.+7 ;IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
04100 JUMPE 10,CP3
04200 CAMN 10,XRN(11)
04300 JRST CPY
04400 CP3: JUMPL 13,STF2 ; SKIP OVER FOR STFCH ROUTINE
04500 MOVE 12,XRN-1(11)
04600 FIXX(12) ;M=RN(L)+2
04700 ADDI 12,2
04800 JSA 16,LOOP ;CALL LOOP(0,M,1,I,L,RN)
04900 JUMP [0]
05000 JUMP 12
05100 JUMP [1]
05200 JUMP PTR+=252
05300 JUMP 11
05400 JUMP XRN
05500 AOS PTR+=250 ;ITEM=ITEM+1
05600 MOVE 13,PTR+=250
05700 MOVE 11,PTR-1(13) ;L=PWDS(ITEM)
05800 STF2: MOVE 14,.COMM.+=8 ;RN(L+2)=R7
05900 MOVEM 14,XRN+1(11)
06000 JUMPGE 13,CP2
06100 SKIPL POSI+=8 ;THIS FOR STFCH
06200 JRST CPY ; IF(JJ2)JJ2=K
06300 MOVE 14,7
06400 AOJ 14,
06500 MOVEM 14,POSI+=8
06600 JRST CPY
06700 CP2: SKIPGE POSI+=8 ;IF(JJ2)JJ2=ITEM
06800 MOVEM 13,POSI+=8
06900 AOJ 12, ;I=I+M+1
07000 ADD 12,PTR+=252
07100 MOVEM 12,PTR+=252
07200 MOVEM 12,PTR(13) ;PWDS(ITEM+1)=I
07300 CPY: CAMGE 7,15 ;1 CONTINUE
07400 AOJA 7,CP1
07500 ;; JRST CP1
07600 JUMPL 13,.+3
07700 MOVE 7,.COMM.+=8 ;R2=R7
07800 MOVEM 7,.COMM. ;DOES THIS MATTER FOR STFCH⎇
07900 JRA 16,(16) ;END
08000
08100 ;SUBROUTINE STFCH
08200 ;INTEGER PWDS
08300 ;COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
08400 ;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
08500 ;1/PTR/PWDS(250),ITEM,LL,I,IX
08600 ;EQUIVALENCE (R7,RJQ(5)),(R6,RJQ(4))
08700 ;DO 1 K=1,ITEM
08800 ;L=PWDS(K)
08900 ;IF(RTLINE(L))GO TO 1
09000 ;IF(OUTLIM(L,3))GO TO 1
09100 ;IF(RN(L+1).NE.R6.AND.R6.NE.0)GO TO 1
09200 ;C DIDN'T MATCH THE CODE NUM.
09300 ;IF(JJ2)JJ2=K
09400 ;RN(L+2)=R7
09500 ;1 CONTINUE
09600 ;END
09700
09800 UPDN: 0 ;SUBROUTINE UPDN(NST)
09900 ;INTEGER PWDS
10000 ;COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
10100 ;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
10200 ;1/PTR/PWDS(250),ITEM,LL,I,IX
10300 MOVE 7,@(16) ;EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
10400 ;1,(R6,RJQ(4))
10500 UPDN0: JSA 16,RTLINE ;DO 1 K=NST,ITEM
10600 JUMP PTR(7) ;L=PWDS(K)
10700 JUMPL UPDN1 ; IF(RTLINE(L))GO TO 1
10800 MOVE 11,PTR(7) ;RY=RN(L+1) -- 11 IS L
10900 MOVE 12,XRN(11) ;IF(RY.GT.16)GO TO 1
11000 CAMG 12,[16.0] ; AC12=RY
11100 CAME 12,[8.0] ;IF(RY.EQ.8)GO TO 1
11200 CAMN 12,[3.0] ;IF(RY.EQ.3)GO TO 1
11300 JRST UPDN1
11400 CAMN 12,.COMM.+7 ;IF(RY.EQ.R6)GO TO 10
11500 JRST UPDN10
11600 SKIPE .COMM.+7 ;IF(R6.NE.0)GO TO 1
11700 JRST UPDN1
11800 UPDN10: CAME 12,[4.0] ; DIDN'T MATCH THE CODE NUM.
11900 JRST UPDN11 ;10 ;IF(RY.NE.4)GO TO 11
12000 MOVE 2,XRN-1(11) ;IF(RN(L).LT.3)GO TO 1
12100 CAMGE 2,[3.0]
12200 JRST UPDN1 ; A BAR LINE
12300 UPDN11: JSA 16,OUTLIM ;11 IF(OUTLIM(L,3))GO TO 2
12400 JUMP PTR(7)
12500 JUMP [3]
12600 JUMPL UPDN2
12700 MOVE 2,.COMM.+=12 ;RN(L+4)=RN(L+4)+R11
12800 FADRM 2,XRN+3(11)
12900 SKIPL POSI+=8 ;IF(JJ2)JJ2=K
13000 JRST UPDN2
13100 MOVE 2,7
13200 AOJ 2,
13300 MOVEM 2,POSI+=8
13400 UPDN2: CAML 12,[4.0] ;2 ;IF(RY.LT.4)GO TO 1
13500 CAML 12,[7.0] ;IF(RY.GE.7)GO TO 1
13600 JRST UPDN1 ; NO WIGGLE ON TRILL
13700 CAME 12,[4.0] ;IF(RY.NE.4.)GO TO 12
13800 JRST UPDN12
13900 MOVE 15,XRN+4(11) ;IF(RN(L+5).EQ.50)GO TO 1
14000 CAMN 15,[50.0] ; 15 IS RN(L+5)
14100 JRST UPDN1 ; CRESC. OR BOX
14200 UPDN12: JSA 16,OUTLIM ;12 ;IF(OUTLIM(L,6))GO TO 1
14300 JUMP PTR(7)
14400 JUMP [6]
14500 JUMPL UPDN1
14600 MOVE 3,.COMM.+=12 ;RN(L+5)=RN(L+5)+R11
14700 FADRM 3,XRN+4(11)
14800 SKIPL POSI+=8 ;IF(JJ2)JJ2=K
14900 JRST UPDN1
15000 MOVE 2,7
15100 AOJ 2,
15200 MOVEM 2,POSI+=8
15300 UPDN1: CAMGE 7,PTR+=250 ;1 ;CONTINUE
15400 AOJA 7,UPDN0
15500 JRA 16,1(16) ;END
15600
15700 NOIR: 0
15800 JRA 16,1(16) ; DUMMY ******
15900
16000 SLEND: 0 ; SUBROUTINE SLEND
16100 MOVE 8,[8.0] ;INTEGER PWDS
16200 MOVE 7,SCM+=80 ;C TO FIND END POINTS OF STAVES
16300 MOVE 4,[4.0];COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,
16400 ; 1 DMAX,UMAX,AA,JMAX,X,Y,BB,RNX(1982)
16500 ; 1/SCM/V(78),I,LCNT,STAFF,LIST(200),REND/PTR/PWDS(250),ITEM,LL,IS,IX
16600 SETZ 5, ;DO 1 K=1,ITEM
16700 SLN1: MOVE 6,PTR(5) ;L=PWDS(K)
16800 ;IF(RN(L+1).NE.8)GO TO 1
16900 CAME 8,XRN(6) ;C FOUND A STAFF
17000 JRST SLN1X ;IF(RN(L+2).NE.STAFF)GO TO 1
17100 CAME 7,XRN+1(6) ;C GOT THE RIGHT ONE
17200 JRST SLN1X ;IF(IT)GO TO 2
17300 SKIPGE XRN+=2000 ;POS=202
17400 JRST SLN2 ;C NOW CHECK LEFT SIDE OF STAFF
17500 MOVE 15,[202.0] ;IF(RN(L).LT.4)RETURN
17600 CAML 4,XRN-1(6) ;P6 WASN'T MENTIONED - SO IT =200
17700 JRST SLN3
17800 ;POS=RN(L+6)+2
17900 MOVE 15,XRN+5(6) ;IF(POS.EQ.2)POS=202
18000 FADR 15,[2.0] ;RETURN
18100 CAMN 15,[2.0] ;2 POS=RN(L+3)-2.3
18200 MOVE 15,[202.0] ;RETURN
18300 JRST SLN3 ;1 CONTINUE
18400 SLN2: MOVE 15,XRN+2(6) ;END
18500 FSBR 15,[2.3]
18600 SLN3: MOVEM 15,XRN+=2001
18700 JRA 16,(16)
18800 SLN1X: AOS 5
18900 CAMGE 5,PTR+=250
19000 JRST SLN1
19100 JRA 16,(16)
19200
19300 POSIT: 0 ; FUNCTION POSIT(V)
19400 MOVE 15,@(16) ; COMMON/XRN/RN(4000)
19500 SKIPGE 15 ; DIMENSION POSNT(0/82)
19600 MOVNS 15 ; EQUIVALENCE (POSNT,RN(3801))
19700 MOVE 14,15 ; 1,(A,RN(3884)),(K,RN(3885))
19800 FIXX(14) ; IF(V)V=-V
19900 ; REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
20000 JSA 16,AMOD ; K=V
20100 JUMP 15 ; A=POSNT(K)
20200 JUMP [1.0] ;POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
20300 ; TYPE /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
20400 MOVE 2,XRN+=3801(14) ; END
20500 FSBR 2,XRN+=3800(14)
20600 FMPR 0,2
20700 FADR 0,XRN+=3800(14)
20800 JRA 16,1(16)
20900 END